home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Libraries / SAT 2.1.2 / Zkrolly ƒ / Zkrolly.p < prev    next >
Encoding:
Text File  |  1994-06-26  |  2.3 KB  |  87 lines  |  [TEXT/PJMM]
  1. program Zkrolly;
  2.     uses
  3.         SAT, sXprite, sZprite;
  4.  
  5.     var
  6.         ignoresp, zp: SpritePtr;
  7.         zWind: WindowPtr;
  8.         r: Rect;
  9.  
  10.     const
  11.         scrollSizeH = 200;
  12.         scrollSizeV = 200;
  13.  
  14.     function IsOptionPressed: Boolean;
  15.         var
  16.             km: KeyMap;
  17.     begin
  18.         GetKeys(km);
  19.         IsOptionPressed := km[58];
  20.     end;
  21.  
  22.     function Zyncho: Boolean;
  23.         var
  24.             where, dest: Rect;
  25.     begin
  26.         where.topLeft := zp^.position;
  27.         where.left := where.left - scrollSizeH div 2;
  28.         where.top := where.top - scrollSizeV div 2;
  29.         if where.left < 0 then
  30.             where.left := 0;
  31.         if where.top < 0 then
  32.             where.top := 0;
  33.         if where.left + scrollSizeH > gSAT.offSizeH then
  34.             where.left := gSAT.offSizeH - scrollSizeH;
  35.         if where.top + scrollSizeV > gSAT.offSizeV then
  36.             where.top := gSAT.offSizeV - scrollSizeV;
  37.         where.bottom := where.top + scrollSizeV;
  38.         where.right := where.left + scrollSizeH;
  39.         SetRect(dest, 0, 0, scrollSizeV, scrollSizeH);
  40.  
  41.         SATCopyBitsToScreen(gSAT.offScreen, where, dest, IsOptionPressed);
  42. {Note that there's hardly any speed difference between fast and safe mode when copying areas this big!}
  43.  
  44.         Zyncho := true; {Tell SAT not to draw on-screen: we do that ourselves!}
  45.     end;
  46.  
  47.     procedure SetupZwind;
  48.         var
  49.             zr: Rect;
  50.             wrld: SysEnvRec;
  51.     begin
  52. {Since SAT hasn't been initialized yet, we can't use colorFlag but have to check environs ourselves.}
  53.         if noErr <> SysEnvirons(1, wrld) then
  54.             ; {ignore errors}
  55.         SetRect(zr, 20, 30, 20 + scrollSizeV, 30 + scrollSizeH);
  56.         if wrld.hasColorQD then
  57.             Zwind := NewCWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0)
  58.         else
  59.             Zwind := NewWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0);
  60.     end;
  61.  
  62. begin
  63.     SetupZwind;
  64.  
  65.     SetRect(r, 0, 0, 510, 340);
  66.     CustomInitSAT(128, 129, r, zwind, nil, false, false, false, true, false);
  67.     InitXprite;
  68.     InitZprite;
  69.     ShowWindow(gSAT.wind);
  70.     SelectWindow(gSAT.wind);
  71.     SATInstallSynch(@Zyncho);
  72.     zp := NewSprite(0, 90, 70, @SetupZprite);
  73.     ignoresp := NewSprite(0, 120, 100, @SetupXprite);
  74.     ignoresp := NewSprite(0, 200, 160, @SetupXprite);
  75.     repeat
  76.         RunSAT(IsOptionPressed);
  77.     until Button;
  78.  
  79. {WARNING! It seems like we mess up the current device somewhere. Probably a bug in SAT}
  80. {(where the device setting isn't perfect yet). Let's set port and device to something nice}
  81. {and safe!}
  82.     SetPort(gSAT.wind);
  83.     if colorFlag then
  84.         SetGDevice(GetMainDevice);
  85. { Finally, make sure we dispose of the sound channel. }
  86.     SATSoundShutup;
  87. end.